home *** CD-ROM | disk | FTP | other *** search
- /* xlinit.c - xlisp initialization module */
- /* Copyright (c) 1985, by David Michael Betz
- All Rights Reserved
- Permission is granted for unrestricted non-commercial use */
-
- #include "xlisp.h"
-
- /* external variables */
- extern NODE *true;
- extern NODE *s_quote,*s_function,*s_bquote,*s_comma,*s_comat;
- extern NODE *s_lambda,*s_macro;
- extern NODE *s_stdin,*s_stdout;
- extern NODE *s_evalhook,*s_applyhook;
- extern NODE *s_tracenable,*s_tlimit,*s_breakenable;
- extern NODE *s_car,*s_cdr,*s_get,*s_svalue,*s_splist,*s_eql;
- extern NODE *k_test,*k_tnot,*k_optional,*k_rest,*k_aux;
- extern NODE *a_subr,*a_fsubr;
- extern NODE *a_list,*a_sym,*a_int,*a_float,*a_str,*a_obj,*a_fptr;
- extern struct fdef ftab1[],ftab2[];
-
- /* xlinit - xlisp initialization routine */
- xlinit()
- {
- struct fdef *fptr;
- NODE *sym;
-
- /* initialize xlisp (must be in this order) */
- xlminit(); /* initialize xldmem.c */
- xlsinit(); /* initialize xlsym.c */
- xldinit(); /* initialize xldbug.c */
- xloinit(); /* initialize xlobj.c */
-
- /* enter the builtin functions */
- for (fptr = ftab1; fptr->f_name; fptr++)
- xlsubr(fptr->f_name,fptr->f_type,fptr->f_fcn);
- for (fptr = ftab2; fptr->f_name; fptr++)
- xlsubr(fptr->f_name,fptr->f_type,fptr->f_fcn);
- #ifdef CPM68K
- xlginit();
- #endif
- #ifdef MEGAMAX
- macfinit();
- #endif
-
- /* enter the 't' symbol */
- true = xlsenter("T");
- true->n_symvalue = true;
-
- /* enter some important symbols */
- s_quote = xlsenter("QUOTE");
- s_function = xlsenter("FUNCTION");
- s_bquote = xlsenter("BACKQUOTE");
- s_comma = xlsenter("COMMA");
- s_comat = xlsenter("COMMA-AT");
- s_lambda = xlsenter("LAMBDA");
- s_macro = xlsenter("MACRO");
- s_eql = xlsenter("EQL");
-
- /* enter setf place specifiers */
- s_car = xlsenter("CAR");
- s_cdr = xlsenter("CDR");
- s_get = xlsenter("GET");
- s_svalue = xlsenter("SYMBOL-VALUE");
- s_splist = xlsenter("SYMBOL-PLIST");
-
- /* enter parameter list keywords */
- k_test = xlsenter(":TEST");
- k_tnot = xlsenter(":TEST-NOT");
-
- /* enter lambda list keywords */
- k_optional = xlsenter("&OPTIONAL");
- k_rest = xlsenter("&REST");
- k_aux = xlsenter("&AUX");
-
- /* enter *standard-input* and *standard-output* */
- s_stdin = xlsenter("*STANDARD-INPUT*");
- s_stdin->n_symvalue = newnode(FPTR);
- s_stdin->n_symvalue->n_fp = stdin;
- s_stdin->n_symvalue->n_savech = 0;
- s_stdout = xlsenter("*STANDARD-OUTPUT*");
- s_stdout->n_symvalue = newnode(FPTR);
- s_stdout->n_symvalue->n_fp = stdout;
- s_stdout->n_symvalue->n_savech = 0;
-
- /* enter the eval and apply hook variables */
- s_evalhook = xlsenter("*EVALHOOK*");
- s_evalhook->n_symvalue = NIL;
- s_applyhook = xlsenter("*APPLYHOOK*");
- s_applyhook->n_symvalue = NIL;
-
- /* enter the error traceback and the error break enable flags */
- s_tracenable = xlsenter("*TRACENABLE*");
- s_tracenable->n_symvalue = NIL;
- s_tlimit = xlsenter("*TRACELIMIT*");
- s_tlimit->n_symvalue = NIL;
- s_breakenable = xlsenter("*BREAKENABLE*");
- s_breakenable->n_symvalue = true;
-
- /* enter a copyright notice into the oblist */
- sym = xlsenter("**Copyright-1985-by-David-Betz**");
- sym->n_symvalue = true;
-
- /* enter type names */
- a_subr = xlsenter(":SUBR");
- a_fsubr = xlsenter(":FSUBR");
- a_list = xlsenter(":CONS");
- a_sym = xlsenter(":SYMBOL");
- a_int = xlsenter(":FIXNUM");
- a_float = xlsenter(":FLONUM");
- a_str = xlsenter(":STRING");
- a_obj = xlsenter(":OBJECT");
- a_fptr = xlsenter(":FILE");
- }
-
- əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə